### CODE FOR:
###
### Partisan Influence on Policy Preferences 
### When Parties and Voters Disagree on Welfare Retrenchment
###
### PART 5: Stakes in the policies
###
### VERSION: 2024-MAR-05


rm(list=ls())
gc()



# WORKING DIRECTORY -------------------------------------------------------
setwd("C:/Users/miros/Desktop/Research/Finland - Partisan Cues in Citizens Attitudes")



# LIBRARIES ---------------------------------------------------------------
library(tidyverse)
library(ggplot2)
library(RColorBrewer)
library(grid)
library(ggpubr)
library(dplyr)
library(fixest)
library(ggtext)
library(tableHTML)



# DATA IMPORT -------------------------------------------------------------
# NOTE: The data file loaded in the next step was prepared in a separate
#       scripts '01_PartyCues-data_prep.R'. If you haven't run the script, 
#       return to the depository and run that script first. Its output is 
#       'BIBU_long.Rda' loaded in the next step.
load("01-data/BIBU_long.Rda")
load("01-data/BIBU_panel.Rda")



# DATA ADJUSTMENTS --------------------------------------------------------
# NOTE: The following part reshapes the data into a suitable format for the
#       fixed effects model estimation.



# _ Coding stakes in the policies -----------------------------------------
# Having stakes in 'retirement tube' removal (i.e., retrenchment)
BIBU.panel<- 
  BIBU.panel %>%
  mutate(stakes_retrenchment = ifelse((OCCUPATION >= 2 & OCCUPATION <= 5) 
                                      & (AGE >= 55 & AGE <= 63), 1, 0))


# Having stakes in extension of schooling (i.e., expansion)
BIBU.panel<- 
  BIBU.panel %>%
  mutate(stakes_expansion = ifelse(HOUSEHOLD == 4, 1, 0))


# Recoding into factors
BIBU.panel$stakes_retrenchment <- factor(BIBU.panel$stakes_retrenchment, levels = c(1, 0))
BIBU.panel$stakes_expansion <- factor(BIBU.panel$stakes_expansion, level = c(1, 0))


# Adding these variables to the long dataset
BIBU.DiD <-
  BIBU.panel %>%
  select(MEMBERID, stakes_retrenchment, stakes_expansion) %>%
  mutate(MEMBERID = as.factor(MEMBERID)) %>%
  full_join(BIBU.DiD, by = "MEMBERID")


# Adjusting time factor
BIBU.DiD$ROUND <- factor(BIBU.DiD$ROUND, levels = c("Round 2", "Round 1"))




# __ Subset of two-wave participants --------------------------------------

# Creating two subsets of data (one for each policy reform)
BIBU.long.TUBE <- na.omit(BIBU.DiD[c("RETIREMENT_TUBE", "MEMBERID", "ROUND", "stakes_retrenchment", "GovParty.Overall", "WEIGHT")])
BIBU.long.SCHOOLING <- na.omit(BIBU.DiD[c("COMPULSORY_SCHOOLING", "MEMBERID", "ROUND", "stakes_expansion", "GovParty.Overall", "WEIGHT")])

# Identifying those 'MEMBERID' which are included twice in the data.
# NOTE: The goal is to subset only those individuals who participated in
#       both waves and we have two data points for each of them.
BIBU.long.TUBE.twice <- data.frame(table(BIBU.long.TUBE$MEMBERID))
BIBU.long.TUBE.twice$Include <- ifelse(BIBU.long.TUBE.twice$Freq == 2, 1, 0)

BIBU.long.SCHOOLING.twice <- data.frame(table(BIBU.long.SCHOOLING$MEMBERID))
BIBU.long.SCHOOLING.twice$Include <- ifelse(BIBU.long.SCHOOLING.twice$Freq == 2, 1, 0)

# Attaching the 'Include' variable (identifying respondents participating in both waves)
BIBU.long.TUBE <- merge(BIBU.long.TUBE, 
                        BIBU.long.TUBE.twice[c("Var1", "Include")], 
                        by.x = "MEMBERID", by.y = "Var1")
BIBU.long.SCHOOLING <- merge(BIBU.long.SCHOOLING, 
                             BIBU.long.SCHOOLING.twice[c("Var1", "Include")], 
                             by.x = "MEMBERID", by.y = "Var1")

# Subsetting only relevant observations (i.e., people participating in both waves)
BIBU.long.TUBE <- subset(BIBU.long.TUBE, Include == 1)
BIBU.long.SCHOOLING <- subset(BIBU.long.SCHOOLING, Include == 1)

# Removing irrelevant objects and variables
BIBU.long.TUBE$Include <- NULL
BIBU.long.SCHOOLING$Include <- NULL
rm(BIBU.long.TUBE.twice, BIBU.long.SCHOOLING.twice)

# NOTE: Now, 'BIBU.long.TUBE' and 'BIBU.long.SCHOOLING' include only 
#       respondents participating in both waves and hence the objects
#       are ready for fixed effects model estimation.




# MODELS ------------------------------------------------------------------

# Model 1 - GOVERNMENT - Abolition of the 'Retirement Tube'
fd.model.1.government <- feols(RETIREMENT_TUBE ~ ROUND:stakes_retrenchment | MEMBERID^stakes_retrenchment + ROUND, 
                               data = filter(BIBU.long.TUBE, GovParty.Overall == "Government voters"), 
                               cluster = "MEMBERID")

# Model 2 - OPPOSITION - Abolition of the 'Retirement Tube'
fd.model.2.opposition <- feols(RETIREMENT_TUBE ~ ROUND:stakes_retrenchment | MEMBERID^stakes_retrenchment + ROUND, 
                               data = filter(BIBU.long.TUBE, GovParty.Overall == "Opposition voters"), 
                               cluster = "MEMBERID")

# Model 3 - GOVERNMENT - Increase of the upper age limit for compulsory schooling
fd.model.3.government <- feols(COMPULSORY_SCHOOLING ~ ROUND:stakes_expansion | MEMBERID^stakes_expansion + ROUND,  
                               data = filter(BIBU.long.SCHOOLING, GovParty.Overall == "Government voters"), 
                               cluster = "MEMBERID")

# Model 4 - OPPOSITION - Increase of the upper age limit for compulsory schooling
fd.model.4.opposition <- feols(COMPULSORY_SCHOOLING ~ ROUND:stakes_expansion | MEMBERID^stakes_expansion + ROUND,  
                               data = filter(BIBU.long.SCHOOLING, GovParty.Overall == "Opposition voters"), 
                               cluster = "MEMBERID")

# Model(s) summary
etable(fd.model.1.government, fd.model.2.opposition, fd.model.3.government, fd.model.4.opposition)






# _ FIGURE 5 --------------------------------------------------------------

# __ Extracting the marginal effects --------------------------------------
margins <-
  data.frame(
    rbind(
      c("Abolition of\nthe 'Retirement Tube'", "Before\nthe reform", "Government voters", "Stakes in policy",  0, NA, NA),
      c("Abolition of\nthe 'Retirement Tube'", "After\nthe reform",   "Government voters", "Stakes in policy",  broom::tidy(fd.model.1.government, conf.int = .95)[1 , c("estimate", "conf.low", "conf.high")]),
      
      c("Abolition of\nthe 'Retirement Tube'", "Before\nthe reform", "Opposition voters", "Stakes in policy",  0, NA, NA),
      c("Abolition of\nthe 'Retirement Tube'", "After\nthe reform",   "Opposition voters", "Stakes in policy",  broom::tidy(fd.model.2.opposition, conf.int = .95)[1 , c("estimate", "conf.low", "conf.high")]),
      
      c("Extension of\nthe compulsory schooling age", "Before\nthe reform", "Government voters", "Stakes in policy",  0, NA, NA),
      c("Extension of\nthe compulsory schooling age", "After\nthe reform",   "Government voters", "Stakes in policy",  broom::tidy(fd.model.3.government, conf.int = .95)[1 , c("estimate", "conf.low", "conf.high")]),
      
      c("Extension of\nthe compulsory schooling age", "Before\nthe reform", "Opposition voters", "Stakes in policy",  0, NA, NA),
      c("Extension of\nthe compulsory schooling age", "After\nthe reform",   "Opposition voters", "Stakes in policy",  broom::tidy(fd.model.4.opposition, conf.int = .95)[1 , c("estimate", "conf.low", "conf.high")])
    ))

# Changing column names
names(margins) <- c("reform", "time", "group", "stakes", "estimate", "conf.low", "conf.high")

# Unlisting the rows
margins$reform <- factor(unlist(margins$reform), levels = c("Abolition of\nthe 'Retirement Tube'", "Extension of\nthe compulsory schooling age"))
margins$time <- factor(unlist(margins$time), levels = c("Before\nthe reform", "After\nthe reform"))
margins$group <- factor(unlist(margins$group), levels = c("Government voters", "Opposition voters"))
margins$stakes <- as.factor(unlist(margins$stakes))
margins$estimate <- as.numeric(unlist(margins$estimate))
margins$conf.low <- as.numeric(unlist(margins$conf.low))
margins$conf.high <- as.numeric(unlist(margins$conf.high))




# Figure
annotate_figure(
  ggarrange(
    
    # __ Figure ---------------------------------------------------------------
    
    # Government voters: Welfare retrenchment
    ggarrange(
      ggplot(filter(margins, reform == "Abolition of\nthe 'Retirement Tube'" & group == "Government voters"), 
             aes(x = time, y = estimate, group = group)) +
        geom_hline(yintercept = 0, colour = "grey60", linetype = "longdash") +
        geom_hline(yintercept = seq(from = -0.50, to = -0.10, by = 0.10), color = "grey90") +
        geom_hline(yintercept = seq(from =  0.10, to =  0.50, by = 0.10), color = "grey90") +
        geom_point(position = position_dodge(width = 0.2)) +
        geom_line(position = position_dodge(width = 0.2)) +
        annotate("richtext", x = 0.5, y =  -0.12/2, hjust = 0, vjust = 0.5, 
                 label = "Reference: Government voters <br>with <b>no stakes</b> in the policy", 
                 size = 7/.pt, colour = "grey60", lineheight = 0.8, fill = NA, label.color = NA) +
        geom_errorbar(aes(ymin = conf.low, ymax = conf.high, width = 0.2), position = position_dodge(width = 0.2)) +
        scale_y_continuous(breaks = seq(-0.6, 0.6, 0.1), labels = c("-0.6", "", "-0.4", "", "-0.2", "", "0.0", "", "0.2", "", "0.4", "", "0.6")) +
        coord_cartesian(xlim = c(0.5, 2.5), ylim = c(-0.6, 0.8), expand = FALSE, clip = "off") +
        labs(y = NULL, x = NULL, title = NULL, color = NULL, shape = NULL) +
        geom_rect(ymin = 0.6, ymax = 0.8, xmin = 0.5, xmax = 2.5, colour = "black", fill = "grey90") +
        annotate("text", x = 1.5, y = 0.7, hjust = 0.5, vjust = -0.10, label = "Welfare retrenchment", fontface = 2, size = 11/.pt) +
        annotate("text", x = 1.5, y = 0.7, hjust = 0.5, vjust =  1.70, label = "Abolition of the \"retirement tube\"", size = 8/.pt) +
        theme(axis.ticks = element_blank(),
              axis.text.x = element_blank(),
              panel.border = element_rect(fill = "transparent"), 
              panel.background = element_rect(colour = "transparent", fill = "transparent"),
              plot.background = element_rect(colour = "transparent"),
              panel.grid = element_blank(), 
              plot.margin=unit(c(0.5, 0.5, 0.5, 0.5),"cm")),
      
      # Government voters: Welfare expansion
      ggplot(filter(margins, reform == "Extension of\nthe compulsory schooling age" & group == "Government voters"), 
             aes(x = time, y = estimate, group = group)) +
        geom_hline(yintercept = 0, colour = "grey60", linetype = "longdash") +
        geom_hline(yintercept = seq(from = -0.50, to = -0.10, by = 0.10), color = "grey90") +
        geom_hline(yintercept = seq(from =  0.10, to =  0.50, by = 0.10), color = "grey90") +
        geom_rect(xmin = 0.5, xmax = 2.5, ymin = -0.6, ymax = 0.6, colour = "black", fill = "transparent") +
        geom_point(position = position_dodge(width = 0.2)) +
        geom_line(position = position_dodge(width = 0.2)) +
        geom_errorbar(aes(ymin = conf.low, ymax = conf.high, width = 0.2), position = position_dodge(width = 0.2)) +
        scale_y_continuous(breaks = seq(-0.6, 0.6, 0.1), labels = c("-0.6", "", "-0.4", "", "-0.2", "", "0.0", "", "0.2", "", "0.4", "", "0.6")) +
        coord_cartesian(xlim = c(0.5, 2.8), ylim = c(-0.6, 0.8), expand = FALSE, clip = "off") +
        labs(y = NULL, x = NULL, title = NULL, color = NULL, shape = NULL) +
        geom_rect(ymin = 0.6, ymax = 0.8, xmin = 0.5, xmax = 2.5, colour = "black", fill = "grey90") +
        annotate("text", x = 1.5, y = 0.7, hjust = 0.5, vjust = -0.10, label = "Welfare expansion", fontface = 2, size = 11/.pt) +
        annotate("text", x = 1.5, y = 0.7, hjust = 0.5, vjust =  1.70, label = "Extension of the compulsory school age", size = 8/.pt) +
        geom_rect(xmin = 2.5, xmax = 2.8, ymin = -0.6, ymax = 0.6, colour = "black", fill = "grey90") +
        annotate("text", x = 2.65, y = 0, hjust = 0.5, vjust = 0.5, label = "Government voters", angle = 270, fontface = 2, size = 11/.pt) +
        theme(axis.ticks = element_blank(),
              axis.text.x = element_blank(),
              axis.text.y = element_blank(),
              panel.border = element_rect(colour = "transparent", fill = "transparent"), 
              panel.background = element_rect(colour = "transparent", fill = "transparent"),
              plot.background = element_rect(colour = "transparent"),
              panel.grid = element_blank(), 
              plot.margin=unit(c(0.5, 0.5, 0.5, 0.5),"cm"))
      ),
    
    
    ggarrange(
      # Opposition voters: Welfare retrenchment
      ggplot(filter(margins, reform == "Abolition of\nthe 'Retirement Tube'" & group == "Opposition voters"), 
             aes(x = time, y = estimate, group = group)) +
        geom_hline(yintercept = 0, colour = "grey60", linetype = "longdash") +
        geom_hline(yintercept = seq(from = -0.50, to = -0.10, by = 0.10), color = "grey90") +
        geom_hline(yintercept = seq(from =  0.10, to =  0.50, by = 0.10), color = "grey90") +
        geom_point(position = position_dodge(width = 0.2)) +
        geom_line(position = position_dodge(width = 0.2)) +
        annotate("richtext", x = 0.5, y = -0.12/2, hjust = 0, vjust = 0.5, 
                 label = "Reference: Opposition voters <br>with <b>no stakes</b> in the policy", 
                 size = 7/.pt, colour = "grey60", lineheight = 0.8, fill = NA, label.color = NA) +
        geom_errorbar(aes(ymin = conf.low, ymax = conf.high, width = 0.2), position = position_dodge(width = 0.2)) +
        scale_y_continuous(breaks = seq(-0.6, 0.6, 0.1), labels = c("-0.6", "", "-0.4", "", "-0.2", "", "0.0", "", "0.2", "", "0.4", "", "0.6")) +
        coord_cartesian(xlim = c(0.5, 2.5), ylim = c(-0.6, 0.6), expand = FALSE, clip = "off") +
        labs(y = NULL, x = NULL, title = NULL, color = NULL, shape = NULL) +
        theme(axis.ticks = element_blank(),
              legend.spacing.y = unit(0.25, "cm"),
              legend.key.size = unit(0.65, "cm"),
              legend.key = element_blank(),
              legend.key.height = unit(1, "cm"),
              panel.border = element_rect(fill = "transparent"), 
              panel.background = element_rect(colour = "transparent", fill = "transparent"),
              plot.background = element_rect(colour = "transparent"),
              panel.grid = element_blank(), 
              plot.margin=unit(c(0.5, 0.5, 0.5, 0.5),"cm")),
      
      # Opposition voters: Welfare expansion
      ggplot(filter(margins, reform == "Extension of\nthe compulsory schooling age" & group == "Opposition voters"), 
             aes(x = time, y = estimate, group = group)) +
        geom_hline(yintercept = 0, colour = "grey60", linetype = "longdash") +
        geom_hline(yintercept = seq(from = -0.50, to = -0.10, by = 0.10), color = "grey90") +
        geom_hline(yintercept = seq(from =  0.10, to =  0.50, by = 0.10), color = "grey90") +
        geom_hline(yintercept = -0.6) +
        geom_point(position = position_dodge(width = 0.2)) +
        geom_line(position = position_dodge(width = 0.2)) +
        geom_errorbar(aes(ymin = conf.low, ymax = conf.high, width = 0.2), position = position_dodge(width = 0.2)) +
        scale_y_continuous(breaks = seq(-0.6, 0.6, 0.1), labels = c("-0.6", "", "-0.4", "", "-0.2", "", "0.0", "", "0.2", "", "0.4", "", "0.6")) +
        coord_cartesian(xlim = c(0.5, 2.8), ylim = c(-0.6, 0.6), expand = FALSE, clip = "off") +
        labs(y = NULL, x = NULL, title = NULL, color = NULL, shape = NULL) +
        geom_rect(xmin = 2.5, xmax = 2.8, ymin = -0.6, ymax = 0.6, colour = "black", fill = "grey90") +
        annotate("text", x = 2.65, y = 0, hjust = 0.5, vjust = 0.5, label = "Opposition voters", angle = 270, fontface = 2, size = 11/.pt) +
        theme(axis.ticks = element_blank(),
              axis.text.y = element_blank(),
              legend.spacing.y = unit(0.25, "cm"),
              legend.key.size = unit(0.65, "cm"),
              legend.key = element_blank(),
              legend.key.height = unit(1, "cm"),
              panel.border = element_rect(fill = "transparent"), 
              panel.background = element_rect(colour = "transparent", fill = "transparent"),
              plot.background = element_rect(colour = "transparent"),
              panel.grid = element_blank(), 
              plot.margin=unit(c(0.5, 0.5, 0.5, 0.5),"cm"))),
    
    ncol = 1,
    nrow = 2),
  left = textGrob(expression(paste(symbol('\254'), " Lower support ",~-~bold(Estimate)~-~" Higher support ", symbol('\256'))), 
                  rot = 90, 
                  vjust = 1, 
                  hjust = 0.525, 
                  gp = gpar(fontsize = 12))) +
  theme(plot.margin=unit(c(0, 0, 0.5, 0),"cm"), 
        plot.background = element_rect(colour = "transparent", fill = "white"))



# Saving the output
ggsave(filename = "02-figures and models/Fig 5 - Stakes.png", width = 17, height = 17, units = "cm", dpi = 600)

